perm filename READRW.F4[PIC,LCS] blob
sn#637517 filedate 1982-01-24 generic text, type T, neo UTF8
00100 C READRW.F4
00200 SUBROUTINE READRW
00300 REAL LF
00400 INTEGER TOTL
00500 COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF
00600 C G=DISTORTAION FACTOR, CCX,CCY=DISPLACEMENT OF CENTER
00700 C DDX,DDY=DISPLACEMENT OF ENTIRE DRAWING, SZF=DRAWING SIZE FACTOR
00800 COMMON /XYZ/X(650),Y(650),Z(650)
00900 COMMON TOTL,CX,CY,LF,RT,TOP,BOT
01000 1 CALL IO(1)
01100 SZF=1.
01200 CALL FACTORS
01300 CALL GETPTS(X,Y,Z,TOTL)
01400 IF(DDY.NE.0)RETURN
01500 C RETURN IF DOING DRAWING TRANSITION.
01600 C READ IN ALL THE POINTS
01700 CALL CENTER
01800 C SET THE CENTER POINT - CX,CY
01900 CALL SLOPES
02000 CALL PERCNT
02100 C JTOTL=TOTAL # OF POINTS IN OUTER LINE OF DRAWING.
02200 2 END
02300
02400 SUBROUTINE RDOUTL
02500 INTEGER TOTL,TOTOUT
02600 COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT
02700 COMMON /OUTL/OX(650),OY(650),OZ(650)
02800 1 CALL IO(2)
02900 CALL OUTPTS(OX,OY,OZ,TOTOUT)
03000 CC CALL GETPTS(OX,OY,OZ,TOTOUT)
03100 C READ IN OUTLINE POINTS
03200 END
03300
03400 SUBROUTINE IO(N)
03500 COMMON/NM2/NM2
03600 10 FORMAT(' TYPE DRAWING FILE NAME '$)
03700 11 FORMAT(' TYPE OUTLINE FILE NAME '$)
03800 13 FORMAT(' TYPE EXPAND FILE NAME '$)
03900 12 FORMAT(A5)
04000 GO TO(1,2,3)N
04100 1 TYPE 10
04200 ACCEPT 12,NM
04300 IF(NM.EQ.' ')NM=NMX
04400 NMX=NM
04500 CALL IFILE(1,NM)
04600 RETURN
04700 2 TYPE 11
04800 ACCEPT 12,NMB
04900 IF(NMB.EQ.' ')NMB=NMQ
05000 NMQ=NMB
05100 CALL IFILE(1,NMB)
05200 RETURN
05300 3 TYPE 13
05400 ACCEPT 12,NM2
05500 IF(NM2.EQ.' ')RETURN
05600 CALL OFILE(20,NM2)
05700 END
05800
05900 SUBROUTINE GETPTS(X,Y,Z,K)
06000 DIMENSION X(1),Y(1),Z(1)
06100 COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF
06200 1 FORMAT(1I,3F)
06300 2 READ(1,1,END=99)K,A,B,Z(K)
06400 X(K)=(A+DDX)*SZF
06500 Y(K)=(B+DDY)*SZF
06600 GO TO 2
06700 99 END
06800
06900 SUBROUTINE OUTPTS(X,Y,Z,K)
07000 DIMENSION X(1),Y(1),Z(1)
07100 COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF
07200 1 FORMAT(1I,3F)
07300 2 READ(1,1,END=99)K,A,B,Z(K)
07400 X(K)=A
07500 Y(K)=B
07600 GO TO 2
07700 99 END
07800
07900 SUBROUTINE CENTER
08000 INTEGER TOTL
08100 REAL LF
08200 COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF,DSZ
08300 COMMON /XYZ/X(650),Y(650),Z(650)
08400 COMMON TOTL,CX,CY,LF,RT,TOP,BOT
08500 LF=X(1)
08600 RT=LF
08700 BOT=Y(1)
08800 TOP=BOT
08900 DO 1 K=2,TOTL
09000 A=X(K)
09100 IF(A.GT.RT)RT=A
09200 IF(A.LT.LF)LF=A
09300 A=Y(K)
09400 IF(A.GT.TOP)TOP=A
09500 1 IF(A.LT.BOT)BOT=A
09600 CX=LF+(RT-LF)/2.+CCX
09700 CY=BOT+(TOP-BOT)/2.+CCY
09800 CX AND CY ARE CENTER OF RECTANGLE (+DISPLACEMENT)
09900 M=CX*DSZ
10000 N=CY*DSZ
10100 CALL AIVECT(M,N)
10200 CALL AVECT(M,N)
10300 CALL DPYOUT(1)
10400 END
10500
10600 SUBROUTINE SLOPES
10700 REAL LF
10800 INTEGER TOTL
10900 COMMON /XYZ/X(650),Y(650),Z(650)
11000 COMMON /S/SL(650),P(650)
11100 COMMON TOTL,CX,CY,LF,RT,TOP,BOT
11200 D=0
11300 DO 1 K=1,TOTL
11400 A=RL(X(K),Y(K))
11500 IF(A.GT.D)D=A
11600 C D=LONGEST LINE FROM POINT TO CENTER
11700 P(K)=A
11800 C AT FIRST P HOLD LENGTH OF LINE FROM POINT TO CENTER.
11900 SL(K)=9999.
12000 1 IF(CX.NE.X(K))SL(K)=(CY-Y(K))/(CX-X(K))
12100 CC DO 2 K=1,TOTL
12200 CC2 P(K)=P(K)/D
12300 C THIS CONVERTS P TO % OF LONGEST LINE. USED IN MAKNEW
12400 END
12500
12600
12700 FUNCTION RL(X,Y)
12800 INTEGER TOTL
12900 COMMON TOTL,CX,CY
13000 C FIND HYPOTENUSE
13100 A=CX-X
13200 B=CY-Y
13300 RL=SQRT(A*A+B*B)
13400 END
13500
13600
13700 SUBROUTINE FACTORS
13800 COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF,DSZ
13900 C G=DISTORTAION FACTOR, CCX,CCY=DISPLACEMENT OF CENTER
14000 C DDX,DDY=DISPLACEMENT OF ENTIRE DRAWING, SZF=DRAWING SIZE FACTOR
14100 1 FORMAT(' TYPE DISTORTION FACTOR (0=1) AND DPY SIZE (0=5) '$)
14200 2 FORMAT(' TYPE DRAWING CENTER DISPLACEMENT COORDS. '$)
14300 3 FORMAT(' TYPE ENTIRE DRAWING DISPLACEMENT COORDS. '$)
14400 4 FORMAT(' TYPE DRAWING SIZE FACTOR (CR=1.) '$)
14500 14 FORMAT(' TYPE % OF TRANSITION '$)
14600 5 FORMAT(2F)
14700 10 FORMAT(A1)
14800 6 WRITE(5,1)
14900 READ(5,5)G,DSZ
15000 IF(G.EQ.0)G=1.0
15100 IF(DSZ.EQ.0)DSZ=5.
15200 REREAD 10,N
15300 IF(N.EQ.'B')GO TO 6
15400 IF(N.NE.'T')GO TO 7
15500 TYPE 14
15600 ACCEPT 5,CCX,CCY
15700 C GET TRANSITION PERCENTAGES.
15800 IF(CCY.EQ.0)CCY=CCX
15850 DDY=1.
15900 RETURN
16000 7 WRITE(5,2)
16100 READ(5,5)CCX,CCY
16200 REREAD 10,N
16300 IF(N.EQ.'B')GO TO 7
16400 8 WRITE(5,3)
16500 READ(5,5)DDX,DDY
16600 REREAD 10,N
16700 IF(N.EQ.'B')GO TO 8
16800 9 WRITE(5,4)
16900 READ(5,5)SZF
17000 IF(SZF.EQ.0)SZF=1.
17100 REREAD 10,N
17200 IF(N.EQ.'B')GO TO 9
17300 END
17400
17500 SUBROUTINE PERCNT
17600 INTEGER TOTL,Q
17700 COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF
17800 COMMON /XYZ/X(650),Y(650),Z(650)
17900 COMMON /S/SL(650),P(650)
18000 COMMON TOTL,CX,CY
18100 SQA=(TOP-CY)/(LF-CX)
18200 SQB=-SQA
18300 C SLOPE OF DIAGONAL OF RECTANGLE
18400 C ASSUMES FIRST CONTINUOUS LINE IS PICTURE OUTLINE
18500 P(1)=1.
18600 DO 100 K=2,TOTL
18700 IF(Z(K).NE.0)GO TO 101
18800 JTOTL=K
18900 100 P(JTOTL)=1.
19000 101 DO 200 K=JTOTL+1,TOTL
19100 J=2
19200 202 IF(HIT(J,X,Y,K,A,B).EQ.0)GO TO 201
19300 C A,B ARE COORDS OF HIT POINT.
19400 J=J+1
19500 GO TO 202
19600
19700 201 RLN=RL(X(K),Y(K))
19800 C GET LENGTH OF LINE FROM CX,CY TO THIS POINT
19900 RLNB=RL(A,B)
20000 8 H=RLN/RLNB
20100 C H=% OF DIST. FROM CENTER TO OUTER LINE OF DRAWING.
20200 200 P(K)=H
20300 END